home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
HPAVC
/
HPAVC CD-ROM.iso
/
MYPROGS.ZIP
/
NIBBLER.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1995-04-06
|
4KB
|
189 lines
program CHENILLETTE;
uses crt;
const nbl=75;
nbc=25;
gauche='1';
droite='2';
haut='9';
bas='6';
limx=100;
limy=100;
gx=5;
gy=5;
ecran=$B800;
rapidite=500;
type Tableau=array[1..limx,1..limy] of byte;
CHENILLE=array[1..300] of byte;
var x,y,corps,i,j,dir,dirx,diry: byte;
t: Tableau;
a: char;
test: boolean;
tx,ty:chenille;
f:text;
ligne:string;
nom:string;
boucle: integer;
PROCEDURE LECTURE;
BEGIN
nom:='decor.bak';
assign(f,Nom);
reset(f);
i:=0;
while NOT eof(f) do
BEGIN
i:=i+1;
readln(f,ligne);
for j:=1 to length(ligne) do
BEGIN
if ligne[j]=' ' then t[j,i]:=0
else
t[j,i]:=ord(ligne[j])-ord('0');
END;
END;
close(f);
END;
PROCEDURE AFF(var t:tableau);
var xgraf,ygraf:byte;
BEGIN
for i:=1 to nbl do
BEGIN
ygraf:=0;
for j:=1 to nbc do
BEGIN
if x<nbl div 2 then xgraf:=i else xgraf:=i+x-(nbl div 2);
if y<nbc div 2 then ygraf:=ygraf+1 else ygraf:=j+y-(nbc div 2);
if x>limx-(nbl div 2)-1 then xgraf:=limx-nbl+i;
if y>limy-(nbc div 2)-1 then ygraf:=limy-nbc+j;
CASE t[xgraf,ygraf] of
0: mem[ecran:(j*80+i)*2]:=32;
3: BEGIN
mem[ecran:(j*80+i)*2+1]:=2;
mem[ecran:(j*80+i)*2]:=162;
END;
2:BEGIN
mem[ecran:(j*80+i)*2+1]:=8;
mem[ecran:(j*80+i)*2]:=219;
END;
1: BEGIN
mem[ecran:(j*80+i)*2+1]:=12;
mem[ecran:(j*80+i)*2]:=ord('@');
END;
END;
END;
END;
END;
FUNCTION COLLISION(x,y:byte;tx,ty:chenille):boolean;
BEGIN
CASE dir OF
0: tX[1]:=tX[1]+1;
1: tY[1]:=tY[1]+1;
2: tX[1]:=tX[1]-1;
3: tY[1]:=tY[1]-1;
END;
if t[tx[1],ty[1]]<>0 then collision:=true else collision:=false;
END;
PROCEDURE RENCONTRE(var x,y:byte);
BEGIN
if dir=3 then dir:=0 else dir:=dir+1;
if collision(x,y,tx,ty) then
BEGIN
CASE dir of
0: dir:=2;
1: dir:=3;
2: dir:=0;
3: dir:=1;
END;
if collision(x,y,tx,ty) then test:=false
else BEGIN
x:=tx[1];y:=ty[1];
END;
END
else BEGIN
x:=tx[1];y:=ty[1];
END;
END;
PROCEDURE DIRECTION(var dir:byte);
BEGIN
if a=droite then dir:=0;
if a=gauche then dir:=2;
if a=haut then dir:=3;
if a=bas then dir:=1;
END;
PROCEDURE MODIFTAB(var t: tableau);
BEGIN
CASE dir OF
0: X:=X+1;
1: Y:=Y+1;
2: X:=X-1;
3: Y:=Y-1;
END;
if (t[x,y]<>0) and (t[x,y]<>3) then BEGIN
RENCONTRE(x,y);
if not test then halt;
END
else
if (t[x,y]=3) and (corps<300) then corps:=corps+1;
for i:=corps downto 2 do BEGIN
tx[i]:=tx[i-1];
ty[i]:=ty[i-1];
END;
tx[1]:=x;
ty[1]:=y;
t[tx[corps],ty[corps]]:=0;
t[x,y]:=1;
END;
BEGIN
writeln('les touches sont:');
writeln(' gauche:1');
writeln(' droite:2');
writeln(' haut:9');
writeln(' bas:6');
writeln(' q:quitter');
readkey;
clrscr;
LECTURE;
x:=10;
y:=50;
t[x,y]:=1;
a:=' ';
dir:=2;
test:=true;
corps:=4;
tx[1]:=x;ty[1]:=y;tx[2]:=x;ty[2]:=y-1;tx[3]:=x;ty[3]:=y-2;
AFF(t);
boucle:=0;
while (a<>'q') or (not test) do
BEGIN
inc(boucle);
if (not(keypressed)) and (boucle=rapidite) then
BEGIN
boucle:=0;
MODIFTAB(t);
AFF(t);
END
else
if keypressed then
BEGIN
if boucle=rapidite then boucle:=0;
a:=readkey;
DIRECTION(dir);
END;
END;
{readln;}
END.